home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / BOXES / ABOUTDLG / ABOUTDLG.ZIP / ABOUTDLG.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-23  |  3KB  |  94 lines
  1. unit aboutdlg;
  2.  
  3. interface
  4. uses
  5.    Classes, Windows, Dialogs, SysUtils, CPUType, Forms;
  6.  
  7. type
  8.   TAboutBoxDlg = Class(TComponent)
  9.  
  10.   private
  11.   FProductName, FVersion, FCopyright, FComments1, FComments2: string;
  12.  
  13.   public
  14.   function Execute: Boolean;
  15.  
  16.   published
  17.   property ProductName: string read FProductName write FProductName;
  18.   property Version: string read FVersion write FVersion;
  19.   property Copyright: string read FCopyright write FCopyright;
  20.   property Comments1: string read FComments1 write FComments1;
  21.   property Comments2: string read FComments2 write FComments2;
  22.   end;
  23.  
  24.   procedure Register;
  25. implementation
  26. uses About;
  27. var
  28.   AboutBox: TAboutBox;
  29.  
  30. function TAboutBoxDlg.Execute: Boolean;
  31. var
  32.   OsInfo: TOSVERSIONINFO;
  33.   SysInfo: TSYSTEMINFO;
  34.   MemStat: TMEMORYSTATUS;
  35.   DiskNo: Integer;
  36. begin
  37.      AboutBox := TAboutBox.Create(Application);
  38.  
  39.      OsInfo.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
  40.      GetVersionEx(OsInfo);
  41.  
  42.      case OsInfo.dwPlatformId of
  43.           VER_PLATFORM_WIN32s        : AboutBox.OSName.Caption := 'Windows 3.1';
  44.           VER_PLATFORM_WIN32_WINDOWS : AboutBox.OSName.Caption := 'Windows 95';
  45.           VER_PLATFORM_WIN32_NT         : AboutBox.OSName.Caption := 'Windows NT';
  46.      end;
  47.  
  48.      AboutBox.OSVersion.Caption := format('%d.%d   Build : %d',
  49.      [OsInfo.dwMajorVersion,OsInfo.dwMinorVersion,LOWORD(OsInfo.dwBuildNumber)]);
  50.  
  51.      GetSystemInfo(SysInfo);
  52.  
  53.      case SysInfo.dwProcessorType of
  54.           PROCESSOR_INTEL_386     : AboutBox.CPUName.Caption := format('%d %s',[SysInfo.dwNumberOfProcessors, 'Intel 80386']);
  55.           PROCESSOR_INTEL_486     : AboutBox.CPUName.Caption := format('%d %s',[SysInfo.dwNumberOfProcessors, 'Intel 80486']);
  56.           PROCESSOR_INTEL_PENTIUM : AboutBox.CPUName.Caption := format('%d %s',[SysInfo.dwNumberOfProcessors, 'Intel Pentium']);
  57.           PROCESSOR_MIPS_R4000    : AboutBox.CPUName.Caption := format('%d %s',[SysInfo.dwNumberOfProcessors, 'MIPS R4000']);
  58.           PROCESSOR_ALPHA_21064   : AboutBox.CPUName.Caption := format('%d %s',[SysInfo.dwNumberOfProcessors, 'ALPHA 21064']);
  59.      end;
  60.  
  61.      MemStat.dwLength := sizeof(TMEMORYSTATUS);
  62.      GlobalMemoryStatus(MemStat);
  63.  
  64.      AboutBox.Memory.Caption := format('Tot: %d KB     Avl: %d KB',[Trunc(MemStat.dwAvailPhys/1024),Trunc(MemStat.dwTotalPhys/1024)]);
  65.  
  66.      DiskNo := 3;
  67.      AboutBox.DiskFree.Caption := '';
  68.      AboutBox.DiskFree1.Caption := '';
  69.      repeat
  70.            if DiskNo < 7 then
  71.               AboutBox.DiskFree.Caption := AboutBox.DiskFree.Caption + format('%s: %d MB  ',[Chr(DiskNo + Ord('A')- 1),Trunc(DiskFree(DiskNo)/1024/1024)])
  72.            else
  73.               AboutBox.DiskFree1.Caption := AboutBox.DiskFree1.Caption + format('%s: %d MB  ',[Chr(DiskNo + Ord('A')- 1),Trunc(DiskFree(DiskNo)/1024/1024)]);
  74.            inc(DiskNo);
  75.      until DiskFree(DiskNo)=-1;
  76.  
  77.      with AboutBox do begin
  78.           ProductName.Caption := FProductName;
  79.           Version.Caption := FVersion;
  80.           Copyright.Caption := FCopyRight;
  81.           Comments1.Caption := FComments1;
  82.           Comments2.Caption := FComments2;
  83.           ProgramIcon.Picture.Graphic := Application.Icon;
  84.           Caption := 'About ' + FProductName;
  85.           Result := (ShowModal = IDOK);     end;
  86.      AboutBox.Free;
  87. end;
  88.  
  89. procedure Register;
  90. begin
  91.   RegisterComponents('Dialogs', [TAboutBoxDlg]);
  92. end;
  93. end.
  94.